perm filename PLTIT.F4[RST,LCS] blob sn#231779 filedate 1976-08-14 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	C**** PLTCMD, FILLMS  ********
C00009 ENDMK
CāŠ—;
C**** PLTCMD, FILLMS  ********
	SUBROUTINE PLTCMD
	COMMON/FRMT/F78F(1),FA1(1),FA5(1),ASK /OUTF/JJ
	DIMENSION NMS(15),RMOV1(15),RMOV2(15)
	COMMON /DL/RSIZ,SAVER,NAME /ALF/INP(72),ML
	COMMON R2,JE,CENTR,JB,RJQ(20),JQ(20)
	EQUIVALENCE (R5,RJQ(3)),(R6,RJQ(4)),(R7,RJQ(5)),(R4,RJQ(2))
	1,(R3,RJQ(1)),(I2,INP(2)),(R8,RJQ(6)),(R9,RJQ(7))
C  BE CAREFUL OF COMMON OVERLAPS WITH NOTWRT,ITMSUB,HOMER, ETC.
	F78F(1)='(78F)'
	FA5(1)='(A5) '
	FA1(1)='(A1) '

	IF(I2.NE.'X')GO TO 1
	I2=0
	RXC=0
	RMOV1(1)='Y'
	NAME=0
14	KA=0
3	KA=KA+1
	IF(MLL.EQ.0)GO TO 15
	K=K-2
	MLL=MLL-1
	IF(MLL.EQ.0)GO TO 10
	GO TO 31
15	TYPE 2,KA
	ACCEPT 11,K,MLL,RSPC
C  TYPE LAST NAME, NUMBER  FOR A SERIES, 2ND NUM FOR FIXED SPACE ".
50	IF(K.NE.' ')GO TO 51
	IF(KA.NE.1)GO TO 10
C  DEFAULT NAME IS 'TMP    1'
	K='TMP'
	MLL=1
51	IF(K.EQ.'99')GO TO 140
C  99=BACKUP
31	IF(LOOKF(K))GO TO 56
C JUMP IF FILE FOUND
	TYPE 55
	GO TO 15
55	FORMAT(' FILE NOT FOUND'/)
11	FORMAT(A5,I,F)
56	IF(MLL.LT.99)GO TO 560
	MLL=0 
561	K=K+2
C  TYPE 'AAAAA 99'  TO FIND ALL IN 'AAAAx' SERIES AUTOMATICALLY
	MLL=MLL+1
	IF(LOOKF(K))GO TO 561
C  KEEPS GOING BACK IF FILES ARE FOUND
	K=K-2
560	NMS(KA)=K
	IF(MLL.EQ.0)GO TO 5
	R8='Y'
	IF(RSPC.NE.0)R8=RSPC
	GO TO 21
5	TYPE 8
	ACCEPT FA5,R8
	IF(R8.EQ.'99')GO TO 15
	IF(R8.NE.'Y')R8=0
	IF(R8.EQ.0)REREAD F78F,R8
C  MOVE NUMBER CAN BE TYPED FOR 'MOVE UP'
21	RMOV1(KA+1)=R8
	RMOV2(KA)=R8
	GO TO 3
140	KA=KA-1
	GO TO 15

10	KB=KA-1
	IF(I3.NE.'G')GO TO 22
	RSIZ=1
	GO TO 222
22	TYPE 9
	ACCEPT F78F,RSIZ,R9
C  SET R9 TO 1 FOR HEAVY STAFF LINES (FOR XGP MAINLY)
	IF(RSIZ.EQ.99)GO TO 5
	IF(RSIZ.EQ.0)RSIZ=1.
	TYPE 550
	ACCEPT 11,JJ
	IF(JJ.EQ.' ')JJ='PLT'
550	FORMAT(' TYPE OUTPUT NAME - '$)
222	KA=0

1	IF(NAME.NE.0)GO TO 12
	IF(KA.NE.KB)GO TO 13
	I2=-1
	RETURN
C  THE END OF THE DATA
13	NAME=NMS(KA+1)
	TYPE 111,NAME
	RETURN
12	KA=KA+1
	NAME=0
	R8=0
	R2=RSIZ
	R3=RSIZ
C  FOR FILLER.  SIZES .LT. 1.6 = EVERY SCAN LINE, .LT. 2.6 = 2, ETC.
	R7=0
	R5=1
	R6=1
	IF(RMOV2(KA).NE.'Y')R7=RMOV2(KA)
	IF(RMOV1(KA).NE.0)R5=0
	IF(RMOV2(KA).NE.0)GO TO 77
	IF(R7.EQ.0)RETURN
77	R6=0
2	FORMAT(' TYPE FILE NAME',I2,1X$)
8	FORMAT(' MOVE UP AT END? ',$)
9	FORMAT(' SIZE FACTOR? ',$)
111	FORMAT(1XA5/)
	END



C******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
	SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
	COMMON/DL/RSIZ,SAVER,NAME
	COMMON/DST/BB,CC/FLM/X(600)
	DIMENSION IDAT(1),NX(600)
	EQUIVALENCE (NX,X)
	COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
C MD=DISPLAY   MP=PLOTTER   MX=XGP
	DATA M2/2/
	DX=DIS
	RX=RHT
	D=RSTJ2*R6
	R=RSTJ2*R7
4	GO TO 1
	C=CC
	B=BB
C  SAVES IT.  IT WILL RETURN LATER.
	BB=B/DIS
	CC=1000
1	KK=-2
	DO 205 J=1,L
	KK=KK+3
	KX=KK+2
	CALL UNPACK(M,N,IDAT(J))
	NX(KX)=2
	IF(LL.EQ.3)NX(KX)=3
	X(KK)=(R2+D*M)*DIS
CC	X(KK)=ROFF((R2+D*M)*DIS)
CC	X(KK+1)=ROFF((CENTR+R*N)*RHT)
	X(KK+1)=(CENTR+R*N)*RHT
3	GO TO 205
	X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
C  FOR DISTORTION
205	CONTINUE
	NX(3)=KX
	DIS=1.0
	RHT=DIS
	IF(IPLT)M=RSIZ+.4
	IF(M.LE.0)M=1
	IF(M.GT.M2)M=M2
C  STOPS DISTORTION IN 'LINES'
2	CALL FILLER(NX,M)
	DIS=DX
	RHT=RX
5	RETURN
C  NEXT TO RESET DISTORTION FACT.
	BB=B
	CC=C
	RETURN
	END

CC	SUBROUTINE PLOT(J,K,L)
CC	CALL PLOTX(J,K,L)
CC	END
C  TO ROTATE 90 DEG. CHANGE IN DDT AT 1M - 'JUMP J' TO 'JUMP K' AND VS-VS.

CF	SUBROUTINE PLOT(I,J,K)
CF	COMMON /OUTF/JJ
CF	DIMENSION N(128)
CF	IF(JJ.EQ.-1)GO TO 4
CF	L=1
CF	N(1)=127
CC	IF(JJ.EQ.' ')JJ='PLT'
CF	CALL PUTFIL(JJ)
CF	JJ=-1
CF4	IF(K.EQ.99)GO TO 1
CF	L=L+1
CF	CALL PAC(N(L),I)
CC	N(L)=J+5000+(I+5000)*10000+(K+4)*100000000
C PACKS   PX000Y000
CF3	IF(L.LT.128)RETURN
CF2	CALL FASTOU(N,128)
CF	L=1
CF	RETURN
CF1	N(1)=L
CF	J=N(L)
CF	DO 100 JJ=L,128
CF100	N(JJ)=J
CF	CALL FASTOU(N,128)
CF	CALL FINFIL
CF	JJ=0
CF	CALL EXIT
CF	END

CF	SUBROUTINE PLOTS(K)
C  DUMMY
CF	END